Ian & Stuart's Australian Mac 1993 September/September 93.iso/Archives/Games/Strategy/Puzzle/GameMaster/GM Dev Kit/Rulebook Sources/Simple Talk ƒ/Simple Talk.p

Text File | 1991-10-26 | 9.2 KB | 479 lines | [TEXT/PJMM]

unit SimpleTalk;

{ Simple Talk © Peter Lewis, Oct 1991 }
{ This program and its source are Povertyware }

interface

    uses
        GameTypes;

    procedure Main (var ger: gameEventRecord);

implementation

    const
        my_dialog_item = 1;
        row_max = 5;
        col_max = 80;
        width = 2;
        inset = 2;
        cursor = '•';
        cr = chr(13);
        lf = chr(10);
        bs = chr(8);
        del = chr(127);
        enter = chr(3);
        tab = chr(9);
        spc = chr(32);
        nul = chr(0);

    type
        pieceType = (pt_None, pt_Top, pt_Bottom);
        players = pt_Top..pt_Bottom;
        connectionStateType = (cs_Local, cs_Remote);
        linesArray = array[1..row_max] of string[col_max];
        playerRecord = record
                lines: linesArray;
                row, col: integer;
            end;
        globalsPeek = ptr;
        gameRecord = record
                globals: globalsPeek;
                player: array[players] of playerRecord;
                connectionstate: connectionStateType;
                item_rect: rect;
                mid_line: integer;
                fi: FontInfo;
            end;
        gamePeek = ^gameRecord;

    procedure Fail (s: str255);
    begin
        DebugStr(s);
    end;

    procedure MyDebug (s: string; n: longint);
        var
            numstr: str255;
    begin
        NumToString(n, numstr);
        DebugStr(concat(s, numstr));
    end;

    procedure DrawChr (ggame: gamePeek; p: pieceType; rw, cl: integer);
        var
            h, v: integer;
            r: rect;
            cw: integer;
    begin
        cw := CharWidth('a');
        with ggame^.item_rect, ggame^.fi do begin
            v := width + inset + ascent + (ascent + descent + leading) * (rw - 1);
            if p = pt_Bottom then
                v := v + ggame^.mid_line
            else
                v := v + top;
            h := left + width + inset + cw * (cl - 1);
            r.left := h;
            r.right := h + cw;
            r.top := v - ascent;
            r.bottom := v + descent;
            MoveTo(h, v);
            EraseRect(r);
            DrawChar(ggame^.player[p].lines[rw][cl]);
        end;
    end;

    procedure DrawLine (ggame: gamePeek; p: pieceType; rw: integer);
        var
            h, v: integer;
            r: rect;
    begin
        with ggame^.item_rect, ggame^.fi do begin
            v := width + inset + ascent + (ascent + descent + leading) * (rw - 1);
            if p = pt_Bottom then
                v := v + ggame^.mid_line
            else
                v := v + top;
            h := left + width + inset;
            r.left := left + width;
            r.right := right - inset;
            r.top := v - ascent;
            r.bottom := v + descent;
            MoveTo(h, v);
            EraseRect(r);
            DrawString(ggame^.player[p].lines[rw]);
        end;
    end;

    procedure DrawGame (wp: windowPtr; item: integer);
        var
            ggame: gamePeek;
            p: pieceType;
            r: integer;
            h: handle;
    begin
        h := handle(GetWRefCon(wp));
        HLock(h);
        ggame := gamePeek(h^);
        PenSize(width, width);
        FrameRect(ggame^.item_rect);
        with ggame^, item_rect do begin
            MoveTo(left, mid_line);
            LineTo(right - width, mid_line);
        end;
        PenNormal;
        for p := pt_Top to pt_Bottom do
            for r := 1 to row_max do
                DrawLine(ggame, p, r);
        HUnlock(h);
    end;

    procedure Main (var ger: gameEventRecord);
        var
            gglobals: globalsPeek;
            ggame: gamePeek;
            gwindow: windowPtr;
            ghandle: handle;

        procedure SetMyTurn;
        begin
            ger.myturn := true;
        end;

        procedure NextPlayer;
        begin
            SetMyTurn;
        end;

        function CheckWin: pieceType;
        begin
            CheckWin := pt_None;
        end;

        procedure ClearRow (p: players; r: integer);
            var
                c: integer;
        begin
            r := (r + row_max - 1) mod row_max + 1;
            for c := 1 to col_max do
                ggame^.player[p].lines[r][c] := spc;
            DrawLine(ggame, p, r);
        end;

        procedure DoChar (p: players; ch: char);
            const
                ff = chr(255);
            procedure DoCh;
            begin
                with ggame^.player[p] do begin
                    lines[row][col] := ch;
                    DrawChr(ggame, p, row, col);
                    col := col + 1;
                    if col = col_max + 1 then begin
                        row := row mod row_max + 1;
                        ClearRow(p, row + 1);
                        col := 1;
                    end;
                    lines[row][col] := cursor;
                    DrawChr(ggame, p, row, col);
                end;
            end;
            procedure DoDel;
            begin
                with ggame^.player[p] do begin
                    lines[row][col] := spc;
                    DrawChr(ggame, p, row, col);
                    if col > 1 then
                        col := col - 1
                    else
                        col := col_max;
                    lines[row][col] := cursor;
                    DrawChr(ggame, p, row, col);
                end;
            end;
            procedure DoCR;
            begin
                with ggame^.player[p] do begin
                    lines[row][col] := spc;
                    DrawChr(ggame, p, row, col);
                    row := row mod row_max + 1;
                    ClearRow(p, row + 1);
                    col := 1;
                    lines[row][col] := cursor;
                    DrawChr(ggame, p, row, col);
                end;
            end;
        begin
            if ch = tab then
                ch := spc;
            if ch = del then
                ch := bs;
            case ch of
                cr, lf:
                    DoCR;
                bs:
                    DoDel;
                spc..ff:
                    DoCh;
                otherwise
                    ;
            end;
        end;

        procedure SendMove (ch: char);
            function NumToStr (n: integer): str15;
                var
                    s: str255;
            begin
                NumToString(n, s);
                while length(s) < 3 do
                    s := concat('0', s);
                NumToStr := s;
            end;
        begin
            ger.event := ge_SendMessage;
            ger.message := concat('C', NumToStr(ord(ch)));
        end;

        procedure DoMove (s: str15);
            function StrToNum (s: str15; off: integer): integer;
                var
                    n: longInt;
            begin
                StringToNum(copy(s, off, 3), n);
                StrToNum := n;
            end;
            var
                ch: char;
        begin
            if length(s) <> 4 then
                Fail('Message not 4 chars')
            else if s[1] <> 'C' then
                Fail('Messsage doesn''t start with C')
            else begin
                ch := chr(StrToNum(s, 2));
                DoChar(pt_Bottom, ch);
            end;
        end;

        procedure DoKey;
        begin
            DoChar(pt_top, chr(ger.int1));
            SendMove(chr(ger.int1));
        end;

        procedure GetRect (var fi: fontInfo; var rct: rect; var mid: integer);
            var
                hdl: handle;
        begin
            with rct do begin
                hdl := GetResource('DITL', 128);
                if hdl = nil then begin
                    Fail('GetResource DITL failed');
                    SetRect(rct, 4, 4, 100, 100);
                end
                else
                    BlockMove(ptr(longInt(hdl^) + 6), @rct, SizeOf(rect));
                TextFont(monaco);
                TextSize(9);
                GetFontInfo(fi);
                right := left + 2 * width + 2 * inset + CharWidth('a') * col_max;
                with fi do begin
                    bottom := top + 3 * width + 4 * inset + row_max * (ascent + descent) * 2 + (row_max - 1) * leading * 2;
                    mid := top + width + 2 * inset + row_max * (ascent + descent) + (row_max - 1) * leading;
                end;
            end;
        end;

        procedure InitGame;
            var
                i: integer;
                rct: rect;
                hdl: handle;
                port: grafport;
                fi: FontInfo;
                mid: integer;
        begin
            ger.globals := nil;
            gglobals := globalsPeek(ger.globals);
            OpenPort(@port);
            GetRect(fi, rct, mid);
            ClosePort(@port);
            with rct do begin
                ger.int1 := left + right; { figure out why :-}
                ger.int2 := top + bottom;
            end;
        end; {proc}

        procedure FinishGame;
        begin
            ger.globals := nil;
        end;

        procedure CommonInit;
            var
                k: integer;
                h: handle;
                rct: rect;
        begin
            GetRect(ggame^.fi, ggame^.item_rect, ggame^.mid_line);
            GetDItem(gwindow, my_dialog_item, k, h, rct);
            rct := ggame^.item_rect;
            InsetRect(rct, -width, -width);
            SetDItem(gwindow, my_dialog_item, k, handle(@DrawGame), rct);
            SetWRefCon(gwindow, longInt(ghandle));
            ggame^.globals := gglobals;
        end;

        procedure UpdateControls;
        begin
        end;

        procedure RestartGame;
            var
                r: integer;
                p: pieceType;
        begin
            for p := pt_Top to pt_Bottom do
                with ggame^.player[p] do begin
                    for r := 1 to row_max do begin
{$PUSH}
{$R-}
                        lines[r][0] := chr(col_max);
{$POP}
                        ClearRow(p, r);
                    end;
                    row := 1;
                    col := 1;
                    lines[1][1] := cursor;
                    DrawChr(ggame, p, row, col);
                end;
            SetMyTurn;
            UpdateControls;
        end;

        procedure GameNew;
        begin
            HUnlock(ghandle);
            SetHandleSize(ghandle, SizeOf(gameRecord));
            HLock(ghandle);
            ggame := gamePeek(ghandle^);
            CommonInit;
            with ggame^ do begin
                connectionstate := cs_Local;
            end; {with}
            RestartGame;
        end;

        procedure OldGame;
        begin
            CommonInit;
            ggame^.connectionstate := cs_Local;
            SetMyTurn;
            UpdateControls;
        end;

        procedure InvalPort;
            var
                r: rect;
        begin
            r := ggame^.item_rect;
            InsetRect(r, width, width);
            EraseRect(r);
            InvalRect(gwindow^.portRect);
        end;

        procedure Swap;
            var
                s: str255;
                r, k: integer;
                pl: playerRecord;
        begin
            with ggame^ do begin
                pl := player[pt_Top];
                player[pt_Top] := player[pt_Bottom];
                player[pt_Bottom] := pl;
            end;
            InvalPort;
            SetMyTurn;
            UpdateControls;
        end;

        procedure ConnectionLost;
        begin
            with ggame^ do begin
                connectionstate := cs_Local;
                SetMyTurn;
            end; {with}
        end;

        procedure ConnectionMade;
        begin
            with ggame^ do begin
                connectionstate := cs_Remote;
                SetMyTurn;
            end; {with}
        end;

        procedure Restart;
        begin
            RestartGame;
            InvalPort;
        end;

        procedure MouseDown;
        begin
        end;

        procedure MessageReceived;
            var
                tmpstr: str255;
                x: longint;
                seq: longint;
                i, j: integer;
        begin
            DoMove(ger.message);
        end;

    begin
        gglobals := globalsPeek(ger.globals);
        ghandle := ger.game;
        if ghandle <> nil then begin
            HLock(ghandle);
            ggame := gamePeek(ghandle^);
        end;
        GetPort(gwindow);
        PenSize(width, width);
        case ger.event of
            ge_InitRuleBook:
                InitGame;
            ge_FinishRuleBook:
                FinishGame;
            ge_NewGame:
                GameNew;
            ge_OldGame:
                OldGame;
            ge_ConnectionLost:
                ConnectionLost;
            ge_ConnectionMade:
                ConnectionMade;
            ge_MessageReceived:
                MessageReceived;
            ge_MouseDown:
                MouseDown;
            ge_Swap:
                Swap;
            ge_Restart:
                Restart;
            ge_KeyDown:
                DoKey;
            otherwise
        end;
        PenNormal;
        if ghandle <> nil then
            HUnlock(ghandle);
    end;

end.